home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_bas / pclvbw10.zip / SIMPLINE.BAS < prev   
BASIC Source File  |  1996-02-09  |  4KB  |  185 lines
  1. ' SIMPLINE.BAS
  2.  
  3. Option Explicit
  4.  
  5. Dim FatalFlag As Integer
  6. Dim Code As Integer
  7.  
  8. Sub Aborting ()
  9.   Dim Code As Integer
  10.   SIMPLE.Print "Fatal Error, Aborting..."
  11.   Code = SioDone(ThePort)
  12.   End
  13. End Sub
  14.  
  15. Sub DisplayChar (ByVal C As Integer)
  16.   Dim Row As Integer
  17.   Dim Col As Integer
  18.   C = &H7F And C
  19.   'process char
  20.   If C = 13 Then
  21.     'carriage control
  22.     CurrentCol = 0
  23.     'plus assumed line feed
  24.     If CurrentRow < 23 Then
  25.       CurrentRow = CurrentRow + 1
  26.       'print CR+LF
  27.       SIMPLE.Print
  28.     Else
  29.       'scroll !
  30.       SIMPLE.Cls
  31.       For Row = 0 To 22
  32.         'print row
  33.         ScreenBuffer(Row) = ScreenBuffer(Row + 1)
  34.         SIMPLE.Print ScreenBuffer(Row)
  35.       Next Row
  36.       'clear bottom row
  37.       ScreenBuffer(23) = Space$(80)
  38.     End If
  39.   ElseIf C = 10 Then
  40.     'throw away line feeds
  41.   Else
  42.     'not CR or LF
  43.     CurrentCol = CurrentCol + 1
  44.     If CurrentCol > 79 Then
  45.       'throw away !
  46.       Exit Sub
  47.     Else
  48.       'save in screen buffer & display
  49.       Mid$(ScreenBuffer(CurrentRow), CurrentCol, 1) = Chr$(C)
  50.       SIMPLE.Print Chr$(C);
  51.     End If
  52.   End If
  53. End Sub
  54.  
  55. Sub DisplayString (Text As String)
  56.   Dim I As Integer
  57.   Dim Length As Integer
  58.   Length = Len(Text)
  59.   For I = 1 To Length
  60.     Call DisplayChar(Asc(Mid$(Text, I, 1)))
  61.   Next I
  62.   Call DisplayChar(13)
  63. End Sub
  64.  
  65. Sub GetIncoming ()
  66.   Dim I As Integer
  67.   Dim TheChar As Integer
  68.   For I = 1 To 82
  69.     TheChar = SioGetc(ThePort, 0)
  70.     If TheChar >= 0 Then
  71.       '''IncomingCount = IncomingCount + 1
  72.       Call DisplayChar(TheChar)
  73.     Else
  74.       Exit For
  75.     End If
  76.   Next I
  77. End Sub
  78.  
  79. Sub GoOffLine ()
  80.   Dim Code As Integer
  81.   OnLineFlag = 0
  82.   'shut down port
  83.   Code = SioDone(ThePort)
  84.   'free DOS memory
  85.   If TxSelector <> 0 Then
  86.     Code = GlobalPageUnlock(TxSelector)
  87.     Code = GlobalDosFree(TxSelector)
  88.     TxSelector = 0
  89.   End If
  90.   If RxSelector <> 0 Then
  91.     Code = GlobalPageUnlock(RxSelector)
  92.     Code = GlobalDosFree(RxSelector)
  93.     RxSelector = 0
  94.   End If
  95.  
  96. End Sub
  97.  
  98. Sub GoOnLine ()
  99.   Dim I As Integer
  100.   Dim dwValue As Long
  101.   Dim dwSize As Long
  102.   Dim SizeCode As Integer
  103.   If OnLineFlag Then
  104.     Exit Sub
  105.   End If
  106.   'set size.
  107.   dwSize = 512&
  108.   SizeCode = Size512
  109.   'allocate RX buffer
  110.   dwValue = GlobalDosAlloc(dwSize)
  111.   If dwValue Then
  112.     'get selector
  113.     RxSelector = (&HFFFF& And dwValue)
  114.     LockCount = GlobalPageLock(RxSelector)
  115.     If LockCount = 0 Then
  116.       SIMPLE.Print "LockCount error"
  117.       End
  118.     End If
  119.   End If
  120.   'allocating RX buffer
  121.   Code = SioRxBuf(ThePort, RxSelector, SizeCode)
  122.   If Code < 0 Then
  123.     SIMPLE.Print "Cannot allocate RX buffer"
  124.     End
  125.   End If
  126.   'allocate TX buffer
  127.   dwValue = GlobalDosAlloc(dwSize)
  128.   If dwValue Then
  129.     'get selector
  130.     TxSelector = (&HFFFF& And dwValue)
  131.     LockCount = GlobalPageLock(TxSelector)
  132.     If LockCount = 0 Then
  133.       SIMPLE.Print "LockCount error"
  134.       End
  135.     End If
  136.   End If
  137.   Code = SioTxBuf(ThePort, TxSelector, SizeCode)
  138.   If Code < 0 Then
  139.     SIMPLE.Print "Cannot allocate TX buffer"
  140.     End
  141.   End If
  142.   'reset the port
  143.   Code = SioReset(ThePort, TheBaudCode)
  144.   If Code < 0 Then
  145.     SIMPLE.Print "ERROR: SioReset returns" + Str$(Code)
  146.     End
  147.   End If
  148.   'call Aborting() if detect error after resetting port
  149.   Call DisplayString("COM" + LTrim$(Str$(1 + ThePort)) + " reset")
  150.   'set DTR & RTS
  151.   Code = SioDTR(ThePort, Asc("S"))
  152.   Code = SioRTS(ThePort, Asc("S"))
  153.   'turn on hardware flow control
  154.   Code = SioFlow(ThePort, 18)
  155.   Call DisplayString("RTS/CTS flow control on")
  156.   'turn on UART FIFO if 16550
  157.   Code = SioFIFO(ThePort, LEVEL_8)
  158.   If Code > 0 Then
  159.     Call DisplayString("16550 Detected")
  160.   End If
  161.   ' set parms
  162.   Code = SioParms(ThePort, TheParity, TheStopBits, TheDataBits)
  163.   ' we're online !
  164.   OnLineFlag = 1
  165. End Sub
  166.  
  167. Sub ShowConfig ()
  168.   Dim A As String
  169.   Dim B As String
  170.   Dim C As String
  171.   Dim D As String
  172.   Dim E As String
  173.   If OnLineFlag Then
  174.     A = " (Online)"
  175.   Else
  176.     A = " (Offline)"
  177.   End If
  178.   B = "COM" + LTrim$(Str$(ThePort + 1))
  179.   C = " @ " + BaudText(TheBaudCode) + " "
  180.   D = Str$(5 + TheDataBits) + ParityText(TheParity)
  181.   E = LTrim$(Str$(1 + TheStopBits))
  182.   SIMPLE.Caption = "SIMPLE: " + B + C + D + E + A
  183. End Sub
  184.  
  185.